home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].zip / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].adf / ShowIcon / ShowIcon2.p < prev    next >
Text File  |  1995-06-23  |  7KB  |  230 lines
  1. PROGRAM showicon2;
  2. { Dieses Programm zeigt, wie man die Images der Icons auf dem eigenen
  3.  Screen darstellt und ist als Testprogramm für AddiPro entstanden, der
  4.  ultimativen FD-Adressverwaltung in Pascal auf dem Amiga ! Übrigens demnächst
  5.  Auf Purity, Aminet, ... }
  6.  
  7.   USES dos,gadtools,execsupport;
  8.   {$incl 'wb.lib','icon.lib'}
  9.   
  10.   VAR win   : p_window;
  11.       t     : Array[1..15] OF TagItem;
  12.       di    : p_drawinfo;
  13.       txattr: Textattr;
  14.       font  : p_textfont;
  15.       fname : STRING;
  16.       vi    : PTR;
  17.       msg   : p_intuimessage;
  18.       gads  : ARRAY[1..8] OF p_gadget;
  19.       glist : p_gadget;
  20.       pgad  : p_gadget;
  21.       aktgad: p_gadget;
  22.       ok    : BOOLEAN;
  23.       pscr  : p_screen;  
  24.       minx,miny,maxx,maxy:INTEGER;
  25.       lr    : BYTE; {linker Rand in Pixel }
  26.       bh    : BYTE; {Barheight}
  27.       fh    : BYTE; {Fonhöhe}
  28.       fb    : BYTE; {Fontbreite} 
  29.     success : BOOLEAN;
  30.           i : INTEGER;
  31.        ende : BOOLEAN;
  32.          da : BOOLEAN; {ob schon das Gadget da ist}
  33.    
  34. {fürs icon}
  35.  VAR dobj : p_DiskObject;
  36.       gad : Gadget;
  37.     gw,gh : INTEGER; { Gadgetwidth, Gadgetheight }
  38.    imptr1,
  39.    imptr2 : p_image; 
  40.     
  41. { fürs appwindow }
  42.  CONST appname='Showicon2 V0.3'
  43.        version='$VER:  Showicon2 V0.3 rev.10 15.06.95 21.38 UHR'
  44.   
  45.  VAR
  46.       appwin: p_appwindow;
  47.       apport: p_msgport;
  48.       appmsg: p_AppMessage;
  49.      winmask,mask,
  50.       appsig: LONG;
  51.       myarg : p_wbarg;
  52.       mydir : BPTR;
  53.    dir,name : STRING[256]
  54.  
  55.  
  56. { -- AppWindow-Port -- }
  57. PROCEDURE InitAppPort;
  58. BEGIN
  59.   Apport := CreateMsgPort;
  60.   IF Apport = NIL THEN
  61.   BEGIN
  62.    HALT(20);
  63.   END;
  64.   ApPort^.mp_Node.ln_Name := AppName;
  65.   ApPort^.mp_Node.ln_Pri  := 0;
  66.   ApPort^.mp_SigTask      := FindTask(NIL);
  67.   AddPort(Apport);
  68. END;
  69.  
  70. PROCEDURE DeleteAppPort;
  71. VAR
  72.   msg : p_Message;
  73. BEGIN
  74.   Forbid;
  75.   IF ApPort <> NIL THEN
  76.   BEGIN
  77.     msg := GetMsg(ApPort);
  78.     WHILE msg <> NIL DO
  79.     BEGIN
  80.       ReplyMsg(msg);
  81.       msg := GetMsg(ApPort);
  82.     END;
  83.     RemPort(ApPort);
  84.     DeleteMsgPort(ApPort);
  85.   END;
  86.   ApPort := NIL;
  87.   Permit;
  88. END;
  89.  
  90. PROCEDURE dobjkram;
  91.  BEGIN
  92.   IF da=TRUE THEN BEGIN         { Schon ein Icon geladen?   }
  93.     i:=RemoveGadget(win,^gad);  { altes Gadget entfernen    }
  94.     freediskobject(dobj);       { freigeben nicht vergessen }
  95.   END;
  96.   IF name[length(name)]='/' THEN name[length(name)]:=CHR(0); {für Verzeichnisse!}
  97.   dobj:= GetDiskObjectNew(name); { Icon holen                }
  98.   gad:=dobj^.do_gadget;          { Gadget aus dem icon klauen}
  99.   gw:=gad.width;                 { Breite,                   }
  100.   gh:=gad.height;                { Höhe des Gadgets merken   } 
  101.   imptr1:=p_image(gad.GadgetRender); { das 1. image holen }
  102.   imptr2:=p_image(gad.SelectRender); { das 2. image holen }
  103.    
  104. { Eigentlich müßte hier der Speicher für die zwei Images reserviert werden und
  105.   die Imagedatas umkopiert werden. Dummerweise weiß ich aber die Größe nicht.
  106.   Deswegen gebe ich die Diskobjektstruktur nicht mehr vor Programmende frei
  107.   -> der Speicher für die Images bleibt reserviert und das Selectimage kann
  108.      gezeichnet werden.
  109.   Wenn man mehr als ein Gadget machen will, dann muß man halt mehrere Diskobject-
  110.   strukturen definieren (am geschicktesten als Array) also für jedes gewünschte
  111.   Gadget eins. Am Programmende aber bitte nicht vergessen freizugeben!   } 
  112.   
  113.   setwindowtitles(win,name,ptr(-1)); {Iconname in Windowitel schreiben}
  114.    
  115.   gad:=gadget(NIL,win^.borderleft,bh+1,gw,gh,GFLG_GADGIMAGE+GFLG_GADGHIMAGE,
  116.   RELVERIFY,$0001,imptr1,imptr2,NIL,0,NIL,1,NIL); {Gadget zusammenbauen}
  117.   
  118.   i:=ADDGADGET(win,^gad,0);       { in die Gadgetliste einfügen}
  119.   REFRESHGADGETS(^gad,win,NIL);   { Refreshen=zeichnen}
  120.   da:=TRUE;                       { Merken, dass die Diskobjektstruktur belegt ist}
  121.  
  122.  END;
  123.   
  124.   
  125. PROCEDURE openlibs;
  126.  BEGIN
  127.   OpenLib(WorkbenchBase, "workbench.library", 37);
  128.   OpenLib(IconBase,"icon.library",0);
  129.  END;
  130.   
  131.  BEGIN
  132.   da:=FALSE;
  133.   openlibs;
  134.   ende:=FALSE;
  135.   pscr:=lockpubScreen('Workbench'); 
  136.   di:=NIL;
  137.   di:=getscreendrawinfo(pscr);
  138.   IF (di=NIL) THEN exit;
  139.   font:=di^.dri_font;             { der folgende Kram ist teilweise unnötig    }
  140.   fb:=font^.tf_ysize;             { ist aber für späteren Ausbau dringeblieben }
  141.   fname:=di^.dri_font^.tf_message.mn_Node.ln_name;
  142.   txattr:=Textattr(fname,fb,0,0);
  143.   bh:=pscr^.barheight;
  144.   freescreendrawinfo(pscr,di);
  145.   initappPort;
  146.   vi:=NIL;
  147.   vi:=GetVisualInfoA(pscr,NIL);
  148.   unLockPubScreen(NIL,pscr);
  149.   Glist:=NIL;
  150.   pgad:=CreateContext(^Glist);
  151.   IF (pgad=NIL) OR (vi=NIL) THEN exit;
  152.   t[1]:=TagItem(WA_InnerWidth,250);
  153.   t[2]:=TagItem(WA_InnerHeight,100);
  154.   t[3].ti_Tag:=WA_Title;
  155.   t[3].ti_data:='Showicon2 (c) 15.06.95 by Røgersøft';
  156.   t[4]:=TagItem(WA_Idcmp,IDCMP_CLOSEWINDOW);
  157.   t[5]:=TagItem(WA_Flags,WFLG_CLOSEGADGET+WFLG_DRAGBAR+WFLG_ACTIVATE+
  158.                 WFLG_DEPTHGADGET+WFLG_SMART_REFRESH+WFLG_NOCAREREFRESH);
  159.   t[6]:=TagItem(WA_Left,50); 
  160.   t[7]:=TagItem(WA_Top,25);
  161.   t[8].ti_Tag:=TAG_DONE;
  162.   win:=OpenWindowTaglist(NIL,^t);
  163.   IF win=NIL THEN exit;
  164.   GT_Refreshwindow(Win,NIL);
  165.  
  166.   Appwin:=AddAppwindowA(1,0,win,Apport,NIL);
  167.   IF AppWin=NIL THEN
  168.    BEGIN
  169.     Closewindow(win);
  170.     Freegadgets(glist);
  171.     Freevisualinfo(vi);  
  172.     HALT(20); 
  173.    END;
  174.   winmask:=LONG(1) SHL LONG(win^.Userport^.mp_SigBit);
  175.   AppSig:=LONG(1) SHL LONG(Apport^.mp_SigBIt);
  176.  
  177.   REPEAT   
  178.    mask:=_wait(winmask OR Appsig);
  179.    IF (mask AND appsig)=AppSig THEN
  180.     BEGIN
  181.      appmsg:=p_AppMessage(GetMsg(Apport));
  182.      WHILE (appmsg<>NIL) DO
  183.      BEGIN
  184.       IF (appmsg^.am_Type=MTYPE_APPWINDOW) THEN
  185.        BEGIN
  186.         myarg:=appmsg^.am_arglist;
  187.         name:=myarg^.wa_name;
  188.         mydir:=myarg^.wa_lock;
  189.         i:=NameFromLock(mydir,^dir,255);
  190.         IF dir[length(dir)]<>':' THEN dir:=dir+'/';
  191.         name:=dir+name;
  192.         dobjkram;
  193.        END;
  194.      Replymsg(p_message(appmsg));
  195.      appmsg:=p_appmessage(GetMsg(apport));
  196.      END;  { Of WHILE }
  197.     END;   
  198.   IF (mask AND winmask) = winmask THEN
  199.    BEGIN
  200.    msg:=GT_getImsg(win^.userport);
  201.    WHILE msg<>NIL DO
  202.    BEGIN
  203.     GT_ReplyImsg(msg);
  204.     CASE msg^.Class OF
  205.      IDCMP_GadgetUP:
  206.        BEGIN
  207.         aktgad:=msg^.iaddress
  208.         CASE aktgad^.gadgetID OF
  209.         1:;
  210.         ELSE END;
  211.        END; 
  212.        
  213.      IDCMP_CLOSEWINDOW: ende:=TRUE;
  214.    
  215.      ELSE END; {OF CASE }
  216.      msg:=GT_GetImsg(win^.Userport);
  217.     END; 
  218.    END;
  219.   UNTIL ende;
  220.   ok:=RemoveAppwindow(appwin); 
  221.   DeleteAppPort;
  222.   IF da THEN BEGIN
  223.    i:=RemoveGadget(win,^gad);  { altes Gadget entfernen    }
  224.    freediskobject(dobj);       { freigeben nicht vergessen }
  225.   END;
  226.   Closewindow(win);
  227.   Freegadgets(glist);
  228.   Freevisualinfo(vi);  
  229.  END.  
  230.